home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tests / cmdtrace.test < prev    next >
Encoding:
Text File  |  1992-11-07  |  4.7 KB  |  160 lines
  1. #
  2. # cmdtrace.test
  3. #
  4. # Tests for the cmdtrace command.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: cmdtrace.test,v 2.0 1992/10/16 04:49:40 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] == ""} then {source testlib.tcl}
  20.  
  21. #
  22. # Proc to do something to trace.
  23. #
  24. proc DoStuff {} {
  25.     set foo [replicate "-TheString-" 10]
  26.     set baz $foo
  27.     set wap 1
  28.     if {$wap} {
  29.         set wap 0
  30.     } else {
  31.         set wap 1
  32.     }
  33. }
  34. proc DoStuff1 {} {DoStuff}
  35. proc DoStuff2 {} {DoStuff1}
  36. proc DoStuff3 {} {DoStuff2}
  37. proc DoStuff4 {} {DoStuff3}
  38.  
  39. #
  40. # Proc to retrieve the output of a trace.  It determines the level of the first
  41. # line.  This is used to strip off level number and identation from each line.
  42. # so that all lines will be indented the same amount.  It also closes the
  43. # trace file.
  44.  
  45. proc GetTrace {cmdtraceFH} {
  46.     set result {}
  47.     seek $cmdtraceFH 0 start
  48.     if {([gets $cmdtraceFH line] < 2) ||
  49.             ([scan $line "%d" level] != 1)} {
  50.         error "*Incorrect format for first line of the trace*"
  51.     }
  52.     set nuke [expr ($level*2)+3]
  53.     seek $cmdtraceFH 0 start
  54.     while {[gets $cmdtraceFH line] >= 0} {
  55.         set linelen [clength $line]
  56.         if {$linelen == 0} {
  57.             continue}
  58.         if {$linelen < $nuke} {
  59.             error "invalid trace line: `$line'"}
  60.         append result "[crange $line $nuke end]\n"
  61.     }
  62.     close $cmdtraceFH
  63.     return $result
  64. }
  65.  
  66. Test cmdtrace-1.1 {command trace: evaluated, truncated} {
  67.     set cmdtraceFH [open CMDTRACE.OUT w+]
  68.     cmdtrace on $cmdtraceFH
  69.     DoStuff4
  70.     cmdtrace off
  71.     GetTrace $cmdtraceFH
  72. } 0 {DoStuff4
  73.   DoStuff3
  74.     DoStuff2
  75.       DoStuff1
  76.         DoStuff
  77.             replicate -TheString- 10
  78.           set foo -TheString--TheString--TheString--TheStr...
  79.           set baz -TheString--TheString--TheString--TheStr...
  80.           set wap 1
  81.           if $wap {\n        set wap 0\n    } else {\n        set wap 1\n    }
  82.             set wap 0
  83. cmdtrace off
  84. }
  85.  
  86. Test cmdtrace-1.2 {command trace: not evaluated, truncated} {
  87.     set cmdtraceFH [open CMDTRACE.OUT w+]
  88.     cmdtrace on $cmdtraceFH noeval flush
  89.     DoStuff4
  90.     cmdtrace off
  91.     GetTrace $cmdtraceFH
  92. } 0 "DoStuff4
  93.   DoStuff3
  94.     DoStuff2
  95.       DoStuff1
  96.         DoStuff
  97.             replicate \"-TheString-\" 10
  98.           set foo \[replicate \"-TheString-\" 10\]
  99.           set baz \$foo
  100.           set wap 1
  101.           if {\$wap} {\\n        set wap 0\\n    } else {\\n        set wap 1...
  102.             set wap 0
  103. cmdtrace off
  104. "
  105.  
  106. Test cmdtrace-1.3 {command trace: evaluated, not truncated} {
  107.     set cmdtraceFH [open CMDTRACE.OUT w+]
  108.     cmdtrace on $cmdtraceFH notruncate
  109.     DoStuff4
  110.     cmdtrace off
  111.     GetTrace $cmdtraceFH
  112. } 0 {DoStuff4
  113.   DoStuff3
  114.     DoStuff2
  115.       DoStuff1
  116.         DoStuff
  117.             replicate -TheString- 10
  118.           set foo -TheString--TheString--TheString--TheString--TheString--TheString--TheString--TheString--TheString--TheString-
  119.           set baz -TheString--TheString--TheString--TheString--TheString--TheString--TheString--TheString--TheString--TheString-
  120.           set wap 1
  121.           if $wap {\n        set wap 0\n    } else {\n        set wap 1\n    }
  122.             set wap 0
  123. cmdtrace off
  124. }
  125.  
  126. Test cmdtrace-1.4 {command trace: not evaluated, not truncated} {
  127.     set cmdtraceFH [open CMDTRACE.OUT w+]
  128.     cmdtrace on $cmdtraceFH notruncate noeval flush
  129.     DoStuff4
  130.     cmdtrace off
  131.     GetTrace $cmdtraceFH
  132. } 0 {DoStuff4
  133.   DoStuff3
  134.     DoStuff2
  135.       DoStuff1
  136.         DoStuff
  137.             replicate "-TheString-" 10
  138.           set foo [replicate "-TheString-" 10]
  139.           set baz $foo
  140.           set wap 1
  141.           if {$wap} {\n        set wap 0\n    } else {\n        set wap 1\n    }
  142.             set wap 0
  143. cmdtrace off
  144. }
  145.  
  146. Test cmdtrace-2.1 {command trace argument error checking} {
  147.     cmdtrace foo
  148. } 1 {expected integer but got "foo"}
  149.  
  150. Test cmdtrace-2.2 {command trace argument error checking} {
  151.     cmdtrace on foo
  152. } 1 {invalid option: expected one of "noeval", "notruncate", "procs", "flush" or a file handle}
  153.  
  154. Test cmdtrace-2.3 {command trace argument error checking} {
  155.     catch {close file20}
  156.     cmdtrace on file20
  157. } 1 {file "file20" isn't open}
  158.  
  159. unlink CMDTRACE.OUT
  160.